home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / COPYSTOA.MOD < prev    next >
Text File  |  1987-06-30  |  4KB  |  92 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*                 CopyStoA -- Copy string to character array               *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. PROCEDURE CopyStoA( S : AnyStr; VAR A ; Length_A : INTEGER );
  6.  
  7. (*--------------------------------------------------------------------------*)
  8. (*                                                                          *)
  9. (*    Procedure: CopyStoA                                                   *)
  10. (*                                                                          *)
  11. (*    Purpose:   Copies string to character array, blank fill               *)
  12. (*                                                                          *)
  13. (*    Calling Sequence:                                                     *)
  14. (*                                                                          *)
  15. (*       CopyStoA( S : AnyStr; VAR A ; Length_A: INTEGER );                 *)
  16. (*                                                                          *)
  17. (*          S        --- String to be copied                                *)
  18. (*          A        --- Character array to be copied into                  *)
  19. (*          Length_A --- No. of characters in A                             *)
  20. (*                                                                          *)
  21. (*    Calls:  None                                                          *)
  22. (*                                                                          *)
  23. (*--------------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    I    : INTEGER;
  27.    AA   : PACKED ARRAY[ 1 .. 1 ] OF CHAR ABSOLUTE A;
  28.  
  29. BEGIN (* CopyStoA *)
  30.  
  31. {
  32.    FOR I := 1 TO MIN( Length_A , LENGTH( S ) ) DO
  33.       AA[I] := S[I];
  34.  
  35.    FOR I := SUCC( I ) TO Length_A DO
  36.       AA[I] := ' ';
  37. }
  38.  
  39.    FillChar( AA[1], Length_A, ' ' );
  40.    MOVE    ( S [1], AA[1],    MIN( Length_A , ORD( S[0] ) ) );
  41.  
  42. END   (* CopyStoA *);
  43.  
  44. (*--------------------------------------------------------------------------*)
  45. (*       CopyS2AR -- Copy string to character array, right adjust           *)
  46. (*--------------------------------------------------------------------------*)
  47.  
  48. PROCEDURE CopyS2AR( S : AnyStr; VAR A ; Length_A : INTEGER );
  49.  
  50. (*--------------------------------------------------------------------------*)
  51. (*                                                                          *)
  52. (*    Procedure: CopyS2AR                                                   *)
  53. (*                                                                          *)
  54. (*    Purpose:   Copies string to character array, blank fill on left       *)
  55. (*                                                                          *)
  56. (*    Calling Sequence:                                                     *)
  57. (*                                                                          *)
  58. (*       CopyS2AR( S : AnyStr; VAR A ; Length_A: INTEGER );                 *)
  59. (*                                                                          *)
  60. (*          S        --- String to be copied                                *)
  61. (*          A        --- Character array to be copied into                  *)
  62. (*          Length_A --- No. of characters in A                             *)
  63. (*                                                                          *)
  64. (*    Calls:  None                                                          *)
  65. (*                                                                          *)
  66. (*--------------------------------------------------------------------------*)
  67.  
  68. VAR
  69.    I        : INTEGER;
  70.    Len_S    : INTEGER;
  71.    Len_A    : INTEGER;
  72.    L        : INTEGER;
  73.    AA       : PACKED ARRAY[ 1 .. 1 ] OF CHAR ABSOLUTE A;
  74.  
  75. BEGIN (* CopyS2AR *)
  76.  
  77.    Len_S  := ORD( S[0] );
  78.    Len_A  := Length_A;
  79.    L      := MIN( Len_A , Len_S );
  80.  
  81.    FOR I := 1 TO L DO
  82.       BEGIN
  83.          AA[Len_A] := S[Len_S];
  84.          Len_A     := PRED( Len_A );
  85.          Len_S     := PRED( Len_S );
  86.       END;
  87.  
  88.    FOR I := Len_A DOWNTO 1 DO
  89.       AA[I] := ' ';
  90.  
  91. END   (* CopyS2AR *);
  92.